home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / prog / buletq10.zip / IDEMO.BAS < prev    next >
BASIC Source File  |  1992-05-31  |  51KB  |  1,816 lines
  1.  
  2. DECLARE SUB DoHighlight (row%)
  3. DECLARE SUB DisplayRecord (RecNo&, row%)
  4. DECLARE SUB ShowDBFStruc (ask4%, ask$, ret$)
  5. DECLARE SUB ShowFieldNames (StartField%)
  6. DECLARE SUB ShowNewFields (newfield%)
  7. DECLARE SUB ShowMainScreen (infile$)
  8. DECLARE SUB ShowStartCL ()
  9.  
  10. DECLARE SUB DoGoHome ()
  11. DECLARE SUB DoGoEnd ()
  12. DECLARE SUB DoHorzScroll (dir%)
  13. DECLARE SUB DoHorzSlide (kbkey%)
  14. DECLARE SUB DoHorzSkip (dir%)
  15. DECLARE SUB DoVertScroll (dir%)
  16. DECLARE SUB DoVertSlide (kbkey%)
  17. DECLARE SUB AdjustHorzSlide (FirstField%)
  18. DECLARE SUB AdjustVertSlide (RecNo&)
  19.  
  20. DECLARE SUB DoInitHots ()
  21. DECLARE FUNCTION DoInit% ()
  22. DECLARE FUNCTION WaitForKey% ()
  23. DECLARE FUNCTION GetRecord% (RecNo&)
  24.  
  25. DECLARE SUB WinClr (row%, col%, rows%, cols%, char%, fg%, bg%)
  26. DECLARE SUB WinGet (row%, col%, rows%, cols%, ID%)
  27. DECLARE SUB WinPrt (txt$, row%, col%, MaxChars%, FirstChar%, fg%, bg%)
  28. DECLARE SUB WinPut (row%, col%, rows%, cols%, ID%)
  29. DECLARE SUB WinSetMode (page%, row%, col%, cstart%, cend%, vmode%)
  30. DECLARE SUB WinScroll (row%, col%, rows%, cols%, dir%, fg%, bg%)
  31. DECLARE SUB WinShift (row%, col%, rows%, cols%, dir%, fg%, bg%)
  32.  
  33. DECLARE SUB MouseFunc (Func%, IM AS ANY, OM AS ANY)
  34. DECLARE SUB MouseTurn (onoff%)
  35. DECLARE FUNCTION SelectEvent% ()
  36. DECLARE FUNCTION InKeyPick% (waitfor%)
  37. DECLARE FUNCTION InMousePick% ()
  38. DECLARE SUB InKeyResponse (row%, col%, maxlen%, retstr$)
  39.  
  40.  
  41. REM $INCLUDE: 'BULLET.BI'
  42. REM $INCLUDE: 'ZWINDO.BI'
  43.  
  44. DECLARE SUB INTERRUPTX (intnum%, ireg AS ANY, oreg AS ANY)
  45.  
  46. DEFINT A-Z
  47.  
  48. 'interactive demo
  49. '31-May-92 chh
  50. '------------------
  51. 'instructions for QuickBASIC 4.5
  52. 'C>bc idemo /o;
  53. 'C>link idemo+zwindo+intrpt2,idemo.exe,nul,bullet;
  54. 'C>link /qu bullet.lib+zwindo+intrpt2,idemo.qlb,nul,bqlb45;
  55.  
  56. '-----------------
  57. 'instructions for PDS BASIC 7.1
  58. 'C>bc idemo /o/ot;
  59. 'C>link /noe/packc/far idemo+zwindo+intrpt2+smallerr+tscnionr,
  60. '       idemo.exe,nul,bullet;
  61. 'C>link /qu bullet.lib+zwindo+intrpt2,idemo.qlb,nul,qbxqlb;
  62.  
  63. '----------------------------------------------------------------------------
  64. 'notes: INTRPT2.OBJ and ZWINDO.OBJ are provided as-is and are not a supported
  65. '       part of the BULLET package. INTRPT2.OBJ is a replacement module for
  66. '       the somewhat buggy INTERRUPT(X) code provided in the QB.LIB/QBX.LIB
  67. '       files of QuickBASIC/BASIC 7.1. ZWINDO.OBJ is a cut-down direct-access
  68. '       screen/video manager, included here only so that you can recompile
  69. '       the IDEMO.BAS program.
  70.  
  71. '       This demo is an abbreviated full-interactive program. There is still
  72. '       a lot that can (and needs to) be done. What you might want to add is
  73. '       select/create indexes, set filters, oh, lots of things. In an effort
  74. '       to keep the IDEMO.EXE included with BULLET package small the guts of
  75. '       the program have not been done.
  76.  
  77. '       To use the program just C>idemo filename.dbf. You can use the provided
  78. '       .DBF file or any .DBF file. To pan fields if the record is longer than
  79. '       the display screen, use the left/right arrows. A mouse can be used on
  80. '       the scroll bars/arrows, too. Esc exits to DOS. To browse the DBF use
  81. '       the up/down arrows, page up/dn, home/end, or the mouse buttons along
  82. '       the right AND bottom.
  83.  
  84. '       For more direct source example see the BB_*.BAS QB source files.
  85.  
  86. '----------
  87. 'event data
  88.  
  89. TYPE ButtonInfoTYPE
  90. x0 AS INTEGER   'col
  91. y0 AS INTEGER   'row
  92. xs AS INTEGER   'cols
  93. ys AS INTEGER   'rows
  94. kv AS INTEGER   'key value
  95. END TYPE
  96.  
  97. TYPE RegTypeX   'interface structure to INTERRUPTX
  98. ax AS INTEGER
  99. bx AS INTEGER
  100. cx AS INTEGER
  101. dx AS INTEGER
  102. BP AS INTEGER
  103. si AS INTEGER
  104. DI AS INTEGER
  105. flags AS INTEGER
  106. ds AS INTEGER
  107. es AS INTEGER
  108. END TYPE
  109.  
  110. TYPE MouseTYPE  'interface structure to MOUSEFUNC
  111. ax AS INTEGER
  112. bx AS INTEGER
  113. cx AS INTEGER
  114. dx AS INTEGER
  115. END TYPE
  116.  
  117. CONST MAXBUTTONS = 7
  118. DIM SHARED ButtonSpots(1 TO MAXBUTTONS) AS ButtonInfoTYPE
  119.  
  120. DIM SHARED IM AS MouseTYPE      'mouse INT33 ins
  121. DIM SHARED OM AS MouseTYPE      'outs
  122. DIM SHARED xreg AS RegTypeX     'regs for interruptx call
  123. DIM SHARED MouseSaved AS INTEGER'=0 then mouse state not saved
  124. DIM SHARED IsMouse AS INTEGER   '=0 then mouse driver not available
  125.  
  126. '-----------
  127. 'window data
  128.  
  129. CONST MAXWINSAVES = 2           '0-based, window 0 reserved
  130.  
  131. DIM SHARED WSP AS WinSavePack
  132. DIM SHARED WFP AS WinFillPack
  133. DIM SHARED WPP AS WinPrintPack
  134. DIM SHARED WCP AS WinCursorPack
  135. DIM SHARED WCPorg AS WinCursorPack
  136.  
  137. DIM SHARED WinBuff(0 TO (MAXWINSAVES + 1) * 2000) AS INTEGER
  138. DIM SHARED atxt$(1 TO 11)
  139.  
  140. '-----------
  141. 'bullet data
  142.  
  143. CONST MAXRECLEN = 4000          'limit DBF recs to 4000 bytes (o)
  144.  
  145. TYPE StrucTYPE                  'type used for DBF struc display
  146. FieldName AS STRING * 11
  147. FieldType AS STRING * 1
  148. FieldLen AS INTEGER
  149. FieldDC AS INTEGER
  150. END TYPE
  151.  
  152. DIM SHARED DFP AS DOSFilePack
  153. DIM SHARED MP AS MemoryPack
  154. DIM SHARED IP AS InitPack
  155. DIM SHARED EP AS ExitPack
  156. DIM SHARED BP AS BreakPack
  157. DIM SHARED RP AS RemotePack
  158. DIM SHARED CDP AS CreateDataPack
  159. DIM SHARED CKP AS CreateKeyPack
  160. DIM SHARED SDP AS StatDataPack
  161. DIM SHARED SKP AS StatKeyPack
  162. DIM SHARED DP AS DescriptorPack
  163. DIM SHARED OP AS OpenPack
  164. DIM SHARED AP AS AccessPack
  165.  
  166. DIM SHARED StrucDBF(1 TO 255) AS StrucTYPE
  167. 'REDIM SHARED StrucDBF(1 TO 1) AS StrucTYPE 'will be resizing so make dynamic
  168.                                            '--field descriptions for program
  169.                                            
  170. DIM SHARED TheRecord AS STRING * 4000   'any type DBF data record
  171.  
  172.  
  173. '------------
  174. 'program data
  175.  
  176. CONST SSROW = 9 - 1                     'scroll screen row start
  177. CONST SSROWS = 10                       'number of rows in scroll screen
  178.  
  179. TYPE FieldDisplayInfoTYPE
  180. FirstField AS INTEGER                   'start field being displayed
  181. FieldsDisplayed AS INTEGER              'number of fields being displayed
  182. END TYPE
  183.  
  184. TYPE RecordDisplayInfoTYPE
  185. CurrRecord AS LONG                      'highlighted recno (for ScrollBar loc)
  186. TopRecord AS LONG                       'first scroll screen rec's number
  187. BotRecord AS LONG                       'last scroll screen rec's number
  188. TopKey AS STRING * 64                   'first scroll screen rec's key
  189. BotKey AS STRING * 64                   'last scroll screen rec's key
  190. END TYPE
  191.  
  192. TYPE PosInfoTYPE
  193. VertSlide AS INTEGER                    'current slide pos (0-7)
  194. HorzSlide AS INTEGER                    'current slide pos (0-74)
  195. TotalRows AS LONG                       'row or records in file
  196. TotalCols AS INTEGER                    'cols or characters in record
  197. ScreenRow AS INTEGER                    'current screen row (1-10)
  198. END TYPE
  199.  
  200. DIM SHARED FDI AS FieldDisplayInfoTYPE
  201. DIM SHARED RDI AS RecordDisplayInfoTYPE
  202. DIM SHARED PI AS PosInfoTYPE
  203.  
  204. DIM SHARED TmpStr AS STRING * 256       'any type fixed-len string
  205. DIM SHARED ZSTR AS STRING * 1           'zero-terminator
  206. DIM SHARED LockFlag AS INTEGER          '=0 then do not use locks
  207. DIM SHARED CurrIDX AS INTEGER           'current index in use (0,1-32)
  208.  
  209. DIM SHARED ISFG AS INTEGER              'info screen colors
  210. DIM SHARED ISBG AS INTEGER
  211. DIM SHARED ISFGB AS INTEGER
  212. DIM SHARED HSFG AS INTEGER              'field name header colors
  213. DIM SHARED HSBG AS INTEGER
  214. DIM SHARED HSFGB AS INTEGER
  215. DIM SHARED SSFG AS INTEGER              'scroll screen colors
  216. DIM SHARED SSBG AS INTEGER
  217. DIM SHARED SSFGB AS INTEGER
  218.  
  219.  
  220. ZSTR = CHR$(0)
  221. LockFlag = 0
  222. CurrIDX = 0
  223.  
  224. ISFG = 7: ISBG = 0: ISFGB = 15          'info screen colors
  225. HSFG = 15: HSBG = 0: HSFGB = 15         'field name header colors
  226. SSFG = 2: SSBG = 0: SSFGB = 10          'scroll screen colors
  227.  
  228.  
  229. '-----
  230. 'go4it
  231.  
  232. stat = DoInit
  233.  
  234. WinSetMode 0, 0, 0, -1, -1, 3  'page,row,col,cstart,cend,vmode
  235. WinClr 0, 0, 25, 80, 32, ISFG, ISBG
  236. WinClr SSROW, 0, SSROWS + 1, 80, 32, SSFG, SSBG
  237.  
  238. infile$ = COMMAND$
  239. IF LEN(infile$) = 0 THEN
  240.    ShowStartCL
  241.    stat = -1
  242. END IF
  243.  
  244. IF stat = 0 THEN
  245.  
  246.    'open DBF file
  247.  
  248.    TmpStr = infile$ + ZSTR
  249.    OP.Func = OpenDXB
  250.    OP.FilenamePtrOff = VARPTR(TmpStr)
  251.    OP.FilenamePtrSeg = VARSEG(TmpStr)
  252.    OP.ASmode = ReadWrite + DenyNone
  253.    stat = BULLET(OP)
  254.  
  255.    IF stat = 0 THEN
  256.       handleDBF = OP.Handle
  257.  
  258.       'check infile
  259.  
  260.       RP.Func = FileRemoteXB
  261.       RP.Handle = OP.Handle
  262.       stat = BULLET(RP)
  263.  
  264.       IF stat = 0 THEN
  265.  
  266.          'get stats/info on DBF
  267.  
  268.          SDP.Func = StatDXB
  269.          SDP.Handle = handleDBF
  270.          stat = BULLET(SDP)
  271.  
  272.          IF stat = 0 THEN
  273.  
  274.             'build the local decriptor info so this program knows what's what
  275.  
  276.             'REDIM StrucDBF(1 TO SDP.fields) AS StrucTYPE
  277.  
  278.             DP.Func = GetDescriptorXB
  279.             DP.Handle = SDP.Handle
  280.  
  281.             FOR i = 1 TO SDP.fields
  282.                DP.FieldNumber = i
  283.                stat = BULLET(DP)
  284.                IF stat = 0 THEN
  285.                   StrucDBF(i).FieldName = DP.FD.FieldName
  286.                   StrucDBF(i).FieldType = DP.FD.FieldType
  287.                   StrucDBF(i).FieldLen = ASC(DP.FD.FieldLength)
  288.                   StrucDBF(i).FieldDC = ASC(DP.FD.FieldDC)
  289.                ELSE
  290.                   EXIT FOR
  291.                END IF
  292.             NEXT
  293.  
  294.             ShowMainScreen infile$
  295.             DoGoHome
  296.  
  297.          END IF 'stat DBF
  298.       END IF 'open DBF
  299.    END IF'remote drive
  300.  
  301.    'do main loop
  302.  
  303.    IF stat = 0 THEN
  304.  
  305.       MouseTurn 1
  306.  
  307.       'event loop
  308.  
  309.       DO
  310.  
  311.          kbkey = InKeyPick(0)
  312.          IF IsMouse THEN
  313.             mbkey = InMousePick
  314.             IF mbkey THEN kbkey = mbkey
  315.          END IF
  316.  
  317.          SELECT CASE kbkey
  318.          CASE 0
  319.          CASE 9       'TAB->
  320.          CASE 1015    '<-TAB
  321.          CASE 1059    'F1
  322.          CASE 1060    'F2
  323.          CASE 1061    'F3
  324.             ask$ = "Enter key expression:"
  325.             ShowDBFStruc 136, ask$, ret$
  326.          CASE 1062    'F4
  327.          CASE 1063    'F5
  328.          CASE 1064    'F6
  329.             ShowDBFStruc 0, ask$, ret$
  330.          CASE 1065    'F7
  331.          CASE 1066    'F8
  332.          CASE 1067    'F9
  333.          CASE 1068    'F10
  334.          CASE 55, 1071          'home
  335.             DoGoHome
  336.          CASE 49, 1079          'end
  337.             DoGoEnd
  338.          CASE 56, 1072, 2090    'up arrow
  339.             DoVertScroll -1
  340.          CASE 50, 1080, 2091    'down arrow
  341.             DoVertScroll 1
  342.          CASE 57, 1073          'page up
  343.             FOR i = 1 TO SSROWS - 1
  344.                DoVertScroll -1
  345.             NEXT
  346.          CASE 51, 1081          'page down
  347.             FOR i = 1 TO SSROWS - 1
  348.                DoVertScroll 1
  349.             NEXT
  350.          CASE 2000 TO 2089      'up/down slider (mouse only)
  351.             DoVertSlide kbkey
  352.          CASE 2100 TO 2174      'left/right slider (mouse only)
  353.             DoHorzSlide kbkey
  354.          CASE 52, 1075, 2190    'left arrow
  355.             DoHorzSkip -1
  356.          CASE 54, 1077, 2191    'right arrow
  357.             DoHorzSkip 1
  358.          CASE 1115              'ctrl left arrow
  359.             DoHorzScroll -1
  360.          CASE 1116              'ctrl right arrow
  361.             DoHorzScroll 1
  362.  
  363.          CASE 13      'Enter
  364.          CASE 27      'Esc
  365.             EXIT DO
  366.          CASE ELSE
  367.          END SELECT
  368.       LOOP
  369.  
  370.    END IF 'main loop
  371.  
  372. END IF 'initXB
  373.  
  374. EP.Func = ExitXB
  375. nix = BULLET(EP)
  376.  
  377. MouseTurn 0
  378. WinClr 20, 0, 5, 80, 32, ISFG, ISBG
  379. IF stat THEN
  380.    txt$ = "IDEMO stat:" + STR$(stat) + ".  See documentation for explanation."
  381. ELSE
  382.    txt$ = "IDEMO stat: ok"
  383. END IF
  384. WinPrt txt$, 20, 0, LEN(txt$), 1, ISFG, ISBG
  385. WCPorg.Func = CursorWIN
  386. WCPorg.Mode = 1                 'reset startup video state
  387. WCPorg.x0 = 0                   'as it was except locate to 24,0
  388. WCPorg.y0 = 23
  389. WCPorg.vmode = -1               'keep screen from clearing
  390. stat = ZWINDO(WCPorg)
  391. END
  392.  
  393. SUB AdjustHorzSlide (FirstField)
  394.  
  395. 'set vertical slide to reflect field postion within record
  396.  
  397. WinPrt "─", SSROW + SSROWS + 1, 1 + PI.HorzSlide, 1, 1, ISFG, ISBG
  398.  
  399. rez = (SDP.fields * 100) \ 75
  400.  
  401. SELECT CASE FirstField
  402. CASE 1
  403.    PI.HorzSlide = 0
  404. CASE SDP.fields
  405.    PI.HorzSlide = 74
  406. CASE ELSE
  407.    PI.HorzSlide = (FirstField * 100) \ rez
  408.    IF PI.HorzSlide < 0 THEN
  409.       PI.HorzSlide = 0
  410.    ELSEIF PI.HorzSlide > 74 THEN
  411.       PI.HorzSlide = 74
  412.    END IF
  413. END SELECT
  414. WinPrt "■", SSROW + SSROWS + 1, 1 + PI.HorzSlide, 1, 1, ISFG, ISBG
  415.  
  416. END SUB
  417.  
  418. SUB AdjustVertSlide (RecNo&)
  419.  
  420. 'set vertical slide to reflect postion within file
  421. 'only valid in non-index read
  422.  
  423. WinPrt "│", SSROW + 1 + PI.VertSlide, 79, 1, 1, ISFG, ISBG
  424.  
  425. rez& = SDP.Recs \ 8
  426. SELECT CASE RecNo&
  427. CASE 1&
  428.    PI.VertSlide = 0
  429. CASE SDP.Recs
  430.    PI.VertSlide = 7
  431. CASE ELSE
  432.    PI.VertSlide = RecNo& \ rez&
  433.    IF PI.VertSlide < 0 THEN
  434.       PI.VertSlide = 0
  435.    ELSEIF PI.VertSlide > 7 THEN
  436.       PI.VertSlide = 7
  437.    END IF
  438. END SELECT
  439. WinPrt "■", SSROW + 1 + PI.VertSlide, 79, 1, 1, ISFG, ISBG
  440.  
  441. END SUB
  442.  
  443. SUB DisplayRecord (RecNo&, row)
  444.  
  445. 'display record at row
  446.  
  447. FirstChar = 1
  448. offset = 1
  449.  
  450. 'find byte offset of the first field displayed on screen
  451. 'offset starts at +1 to account for delete tag
  452.  
  453. i = 1
  454. DO WHILE FDI.FirstField <> i
  455.    offset = offset + StrucDBF(i).FieldLen
  456.    i = i + 1
  457. LOOP
  458.  
  459. 'put the field data up: recno, delete tag, field data
  460.  
  461. fg = ISFG
  462. bg = ISBG
  463. col = 0
  464. txt$ = RIGHT$("       " + LTRIM$(STR$(RecNo&)), 7)
  465. WinPrt txt$, row, col, LEN(txt$), FirstChar, fg, bg
  466.  
  467. fg = SSFG
  468. bg = SSBG
  469. IF ASC(TheRecord) = 42 THEN
  470.    col = 7
  471.    txt$ = "*"
  472.    WinPrt txt$, row, col, LEN(txt$), FirstChar, fg, bg
  473. END IF
  474. col = 8
  475.  
  476. FOR i = FDI.FirstField TO FDI.FirstField + FDI.FieldsDisplayed - 1
  477.    FieldLen = StrucDBF(i).FieldLen
  478.  
  479.    'pad field with spaces if field name > field length
  480.  
  481.    xchars = 0
  482.    txt$ = LEFT$(StrucDBF(i).FieldName, INSTR(StrucDBF(i).FieldName, ZSTR) - 1)
  483.    tl = LEN(txt$)
  484.    IF FieldLen < tl THEN xchars = tl - FieldLen
  485.  
  486.    txt$ = MID$(TheRecord, offset + 1, FieldLen) + SPACE$(xchars)
  487.    offset = offset + FieldLen
  488.    SELECT CASE StrucDBF(i).FieldType
  489.    CASE "B"     'special BULLET binary
  490.                 'of concern is the field len to be displayed since the
  491.                 'descriptor field length contains the size of the binary
  492.                 'field, 2 or 4 --- here we just use the fieldname size, 10
  493.       txt2$ = SPACE$(10)
  494.       IF FieldLen = 4 THEN
  495.          RSET txt2$ = STR$(CVL(LEFT$(txt$, FieldLen)))
  496.       ELSEIF FieldLen = 2 THEN
  497.          RSET txt2$ = STR$(CVL(LEFT$(txt$, FieldLen)))
  498.       ELSE
  499.          RSET txt2$ = "*?*"
  500.       END IF
  501.       WinPrt txt2$, row, col, LEN(txt$), FirstChar, fg, bg
  502.    CASE "C"     'character
  503.       WinPrt txt$, row, col, LEN(txt$), FirstChar, fg, bg
  504.    CASE "D"     'date
  505.       txt$ = MID$(txt$, 5, 2) + "/" + MID$(txt$, 7, 2) + "/" + MID$(txt$, 3, 2)
  506.       WinPrt txt$, row, col, LEN(txt$), FirstChar, fg, bg
  507.    CASE "L"     'logical
  508.       SELECT CASE UCASE$(LEFT$(txt$, 1))
  509.       CASE " "
  510.       CASE "T", "Y"
  511.          txt$ = "T"
  512.       CASE "F", "N"
  513.          txt$ = "F"
  514.       CASE ELSE
  515.          txt$ = "?"
  516.       END SELECT
  517.       WinPrt txt$, row, col, LEN(txt$), FirstChar, fg, bg
  518.    CASE "M"     'memo
  519.       txt$ = "memo"
  520.       WinPrt txt$, row, col, LEN(txt$), FirstChar, fg, bg
  521.    CASE "N"     'numeric
  522.       RSET txt$ = txt$
  523.       WinPrt txt$, row, col, LEN(txt$), FirstChar, fg, bg
  524.    CASE ELSE
  525.    END SELECT
  526.    col = col + FieldLen + xchars + 1
  527. NEXT
  528.  
  529. END SUB
  530.  
  531. SUB DoGoEnd
  532.  
  533. 'reset for end position
  534.  
  535. ShowFieldNames 1
  536. WinClr SSROW + 1, 0, SSROWS, 79, 32, SSFG, SSBG
  537.  
  538. IF CurrIDX = 0 THEN
  539.    startrec& = SDP.Recs - SSROWS + 1
  540.    IF startrec& < 1 THEN startrec& = 1
  541.    row = 0
  542.    DoHorzSlide 2174
  543.    FOR i& = startrec& TO startrec& + SSROWS - 1
  544.       stat = GetRecord(i&)
  545.       IF stat THEN EXIT FOR
  546.       row = row + 1
  547.       DisplayRecord i&, SSROW + row
  548.    NEXT
  549.    IF stat = 0 THEN
  550.       RDI.CurrRecord = i& - 1
  551.       RDI.TopRecord = startrec&
  552.       RDI.BotRecord = RDI.CurrRecord
  553.       PI.ScreenRow = 0
  554.       DoHighlight row
  555.       PI.ScreenRow = row
  556.       AdjustVertSlide RDI.BotRecord
  557.    END IF
  558. ELSE
  559.    'key order
  560. END IF
  561.  
  562. END SUB
  563.  
  564. SUB DoGoHome
  565.  
  566. 'reset for home position
  567.  
  568. ShowFieldNames 1
  569. WinClr SSROW + 1, 0, SSROWS, 79, 32, SSFG, SSBG
  570.  
  571. IF CurrIDX = 0 THEN
  572.    row = 0
  573.    FOR i& = 1 TO SSROWS
  574.       stat = GetRecord(i&)
  575.       IF stat THEN EXIT FOR
  576.       row = row + 1
  577.       DisplayRecord i&, SSROW + row
  578.    NEXT
  579.    RDI.CurrRecord = 1&
  580.    RDI.TopRecord = 1&
  581.    RDI.BotRecord = i& - 1
  582.    PI.ScreenRow = 0
  583.    DoHighlight 1
  584.    PI.ScreenRow = 1
  585.    PI.TotalRows = SDP.Recs
  586.    PI.TotalCols = SDP.RecLen
  587.    AdjustHorzSlide 1
  588.    AdjustVertSlide 1&
  589. ELSE
  590.    'key order
  591. END IF
  592.  
  593. END SUB
  594.  
  595. SUB DoHighlight (row)
  596.  
  597. 'highlight row (row relative scroll window, 1-10)
  598. 'first norm previous highlighted row, then do specified row and update PI
  599.  
  600. col = 7
  601. rows = 1
  602. cols = 72
  603. char = 0
  604. IF PI.ScreenRow THEN
  605.    WinClr SSROW + PI.ScreenRow, col, rows, cols, char, SSFG, SSBG
  606.    PI.ScreenRow = row
  607.    WinClr SSROW + PI.ScreenRow, col, rows, cols, char, SSFGB, SSBG
  608. ELSE
  609.    PI.ScreenRow = row
  610.    WinClr SSROW + PI.ScreenRow, col, rows, cols, char, SSFGB, SSBG
  611. END IF
  612.    
  613. END SUB
  614.  
  615. SUB DoHorzScroll (dir)
  616.  
  617. 'shift over a character at a time
  618. '--currently does not update fields longer than scoll screen width
  619. 'if shift encapsulates entire field, new field brought to start
  620. 'this routine could use some cleanup
  621. '(also, this routine called when Ctrl-arrow is used, not when plain arrow
  622. 'is, which makes it somewhat reverse the dBASE browse mode)
  623.  
  624. kbkey = PI.HorzSlide + 2100 + dir
  625. IF kbkey >= 2100 AND kbkey <= 2174 THEN
  626.    WinShift SSROW, 7, SSROWS + 1, 72, dir, SSFG, SSBG
  627.    DoHorzSlide kbkey
  628. END IF
  629.  
  630. END SUB
  631.  
  632. SUB DoHorzSkip (dir)
  633.  
  634. 'update slider by whole field jumps
  635. 'reflect new field start
  636.  
  637. newfield = FDI.FirstField + dir
  638. ShowNewFields newfield
  639. AdjustHorzSlide FDI.FirstField
  640.  
  641. END SUB
  642.  
  643. SUB DoHorzSlide (kbkey)
  644.  
  645. 'update slider
  646. 'reflect new field start
  647.  
  648. WinPrt "─", SSROW + SSROWS + 1, 1 + PI.HorzSlide, 1, 1, ISFG, ISBG
  649. PI.HorzSlide = kbkey - 2100
  650. WinPrt "■", SSROW + SSROWS + 1, 1 + PI.HorzSlide, 1, 1, ISFG, ISBG
  651.  
  652. clf = FDI.FirstField + FDI.FieldsDisplayed - 1  'clf=current last field
  653.  
  654. IF clf <= SDP.fields THEN
  655.    
  656.    rez = (SDP.fields * 100) \ 75
  657.    newfield = ((rez * PI.HorzSlide) \ 100) + 1
  658.  
  659.    IF newfield <> FDI.FirstField THEN ShowNewFields newfield
  660.  
  661. END IF
  662.  
  663. END SUB
  664.  
  665. FUNCTION DoInit
  666.  
  667. 'free some memory for the OS, initialize BULLET,
  668. 'register ExitXB with _atexit, and get video state
  669.  
  670. exitstat = 0
  671.  
  672. MP.Func = MemoryXB
  673. stat = BULLET(MP)
  674. IF MP.Memory < 140000 THEN
  675.     QBheap& = SETMEM(-150000)   'hog wild, 64K would do okay
  676.     MP.Func = MemoryXB
  677.     stat = BULLET(MP)
  678.     IF MP.Memory < 140000 THEN exitstat = 8 'follow through with Init
  679. END IF
  680.  
  681. IF stat = 0 THEN
  682.    IP.Func = InitXB
  683.    IF exitstat = 0 THEN
  684.       IP.JFTmode = 1            'we may need lots of files open
  685.    ELSE
  686.       IP.JFTmode = 0            'but only if the memory is available
  687.    END IF
  688.    stat = BULLET(IP)
  689.    IF stat = 0 THEN
  690.       EP.Func = AtExitXB
  691.       stat = BULLET(EP)         'doubtful that this would fail
  692.  
  693.       BP.Func = BreakXB
  694.       BP.Mode = 0
  695.       stat = BULLET(BP)
  696.  
  697.    END IF
  698. END IF
  699.  
  700. IF stat = 0 THEN
  701.    WCP.Func = CursorWIN
  702.    WCP.Mode = 0                 'get startup video state
  703.    stat = ZWINDO(WCP)           'returns 233 if InitXB not active
  704.    WCPorg.page = WCP.page
  705.    WCPorg.x0 = WCP.x0
  706.    WCPorg.y0 = WCP.y0
  707.    WCPorg.cstart = WCP.cstart
  708.    WCPorg.cend = WCP.cend
  709.    WCPorg.vmode = WCP.vmode
  710.  
  711.    'init mouse and hot spots
  712.  
  713.    MouseFunc 0, IM, OM
  714.    IsMouse = OM.ax
  715.    IF IsMouse THEN DoInitHots
  716.  
  717.    'init globals
  718.  
  719.    PI.VertSlide = 0
  720.    PI.HorzSlide = 0
  721.  
  722. END IF
  723. IF exitstat THEN stat = exitstat
  724. DoInit = stat
  725.  
  726. END FUNCTION
  727.  
  728. SUB DoInitHots
  729.  
  730. 'set the mouse hot spots
  731.  
  732. ButtonSpots(1).x0 = 79          'up/down slider
  733. ButtonSpots(1).y0 = 9
  734. ButtonSpots(1).xs = 1
  735. ButtonSpots(1).ys = 8
  736. ButtonSpots(1).kv = 2000        '2000=top, +1 for each lower y-pos
  737.  
  738. ButtonSpots(2).x0 = 1           'left/right slider
  739. ButtonSpots(2).y0 = 19
  740. ButtonSpots(2).xs = 75
  741. ButtonSpots(2).ys = 1
  742. ButtonSpots(2).kv = 2100        '2100=left, +1 for each higher x-pos
  743.  
  744. ButtonSpots(3).x0 = 79          'up arrow
  745. ButtonSpots(3).y0 = 17
  746. ButtonSpots(3).xs = 1
  747. ButtonSpots(3).ys = 1
  748. ButtonSpots(3).kv = 2090
  749.  
  750. ButtonSpots(4).x0 = 79          'down arrow
  751. ButtonSpots(4).y0 = 18
  752. ButtonSpots(4).xs = 1
  753. ButtonSpots(4).ys = 1
  754. ButtonSpots(4).kv = 2091
  755.  
  756. ButtonSpots(5).x0 = 77          'left arrow
  757. ButtonSpots(5).y0 = 19
  758. ButtonSpots(5).xs = 1
  759. ButtonSpots(5).ys = 1
  760. ButtonSpots(5).kv = 2190
  761.  
  762. ButtonSpots(6).x0 = 79          'right arrow
  763. ButtonSpots(6).y0 = 19
  764. ButtonSpots(6).xs = 1
  765. ButtonSpots(6).ys = 1
  766. ButtonSpots(6).kv = 2191
  767.  
  768. 'put the Fkey hots here too (update MAXBUTTONS from 7)
  769.  
  770. ButtonSpots(MAXBUTTONS).x0 = 70 'Esc
  771. ButtonSpots(MAXBUTTONS).y0 = 22
  772. ButtonSpots(MAXBUTTONS).xs = 3
  773. ButtonSpots(MAXBUTTONS).ys = 1
  774. ButtonSpots(MAXBUTTONS).kv = 27
  775.  
  776. END SUB
  777.  
  778. SUB DoVertScroll (dir)
  779.  
  780. 'move the highlight bar in direction,
  781. ' dir=-1 moves toward start of file,dir=1 moves toward end of file
  782. 'if at bottom of screen:
  783. ' norm highlight, scroll screen up, get next record and display, highlight
  784. 'if at top:
  785. ' norm highlight, scroll screen down, get prev record and display, highlight
  786.  
  787. col = 7         'used to re/set highlight
  788. rows = 1
  789. cols = 72
  790. char = 0
  791.  
  792. SELECT CASE PI.ScreenRow
  793. CASE SSROWS
  794.    'at bottom
  795.    IF dir < 0 THEN
  796.       DoHighlight PI.ScreenRow + dir
  797.       IF CurrIDX = 0 THEN RDI.CurrRecord = RDI.CurrRecord + dir
  798.    ELSE
  799.       IF CurrIDX = 0 THEN
  800.          stat = GetRecord(RDI.BotRecord + 1)
  801.          IF stat = 0 THEN
  802.             RDI.CurrRecord = RDI.CurrRecord + 1
  803.             RDI.TopRecord = RDI.TopRecord + 1
  804.             RDI.BotRecord = RDI.BotRecord + 1
  805.             WinClr SSROW + PI.ScreenRow, col, rows, cols, char, SSFG, SSBG
  806.             WinScroll SSROW + 1, 0, SSROWS, 78, 1, SSFG, SSBG
  807.             DisplayRecord RDI.BotRecord, SSROW + SSROWS
  808.             DoHighlight PI.ScreenRow
  809.             AdjustVertSlide RDI.CurrRecord
  810.          END IF
  811.       ELSE
  812.          'get by current key
  813.       END IF
  814.    END IF
  815.  
  816. CASE 1
  817.    'at top
  818.    IF dir > 0 THEN
  819.       DoHighlight PI.ScreenRow + dir
  820.       IF CurrIDX = 0 THEN
  821.          RDI.CurrRecord = RDI.CurrRecord + dir
  822.       ELSE
  823.          'get from ??
  824.       END IF
  825.    ELSE
  826.       IF CurrIDX = 0 THEN
  827.          stat = GetRecord(RDI.TopRecord - 1)
  828.          IF stat = 0 THEN
  829.             RDI.CurrRecord = RDI.CurrRecord - 1
  830.             RDI.TopRecord = RDI.TopRecord - 1
  831.             RDI.BotRecord = RDI.BotRecord - 1
  832.             WinClr SSROW + PI.ScreenRow, col, rows, cols, char, SSFG, SSBG
  833.             WinScroll SSROW + 1, 0, SSROWS, 78, -1, SSFG, SSBG
  834.             DisplayRecord RDI.TopRecord, SSROW + 1
  835.             DoHighlight PI.ScreenRow
  836.             AdjustVertSlide RDI.CurrRecord
  837.          END IF
  838.       ELSE
  839.          'get by current key
  840.       END IF
  841.    END IF
  842.  
  843. CASE ELSE
  844.    DoHighlight PI.ScreenRow + dir
  845. END SELECT
  846.  
  847. END SUB
  848.  
  849. SUB DoVertSlide (kbkey)
  850.  
  851. 'update slider
  852. 'if in non-index then reflect current record number to slider position
  853. 'if index then just reflect top of or bottom of (GetFirst/Last)
  854.  
  855. WinPrt "│", SSROW + 1 + PI.VertSlide, 79, 1, 1, ISFG, ISBG
  856. PI.VertSlide = kbkey - 2000
  857. WinPrt "■", SSROW + 1 + PI.VertSlide, 79, 1, 1, ISFG, ISBG
  858.  
  859. IF CurrIDX = 0 THEN
  860.  
  861.    'handle non-indexed access
  862.  
  863.    rez& = SDP.Recs \ 8
  864.    newrec& = rez& * PI.VertSlide
  865.    IF newrec& <= 0 OR PI.VertSlide = 0 THEN
  866.       newrec& = 1
  867.    ELSEIF newrec& > SDP.Recs OR PI.VertSlide = 7 THEN
  868.       newrec& = SDP.Recs - SSROWS + 1
  869.    END IF
  870.  
  871.    IF (newrec& > RDI.CurrRecord - rez& + 1) AND (newrec& < RDI.CurrRecord + rez& - 1) THEN
  872.       'already within position
  873.    ELSE
  874.       WinClr SSROW + 1, 0, SSROWS, 79, 32, SSFG, SSBG
  875.       row = 0
  876.       FOR i& = newrec& TO newrec& + SSROWS - 1
  877.          stat = GetRecord(i&)
  878.          IF stat THEN EXIT FOR
  879.          row = row + 1
  880.          DisplayRecord i&, SSROW + row
  881.       NEXT
  882.       RDI.CurrRecord = newrec&
  883.       RDI.TopRecord = newrec&
  884.       RDI.BotRecord = i& - 1        'i from for/next loop of DisplayRecord
  885.       RDI.TopKey = ZSTR
  886.       RDI.BotKey = ZSTR
  887.       DoHighlight 1
  888.    END IF
  889. ELSE
  890.  
  891.    'handle keyed access
  892.  
  893. END IF
  894.  
  895. END SUB
  896.  
  897. FUNCTION GetRecord (RecNo&)
  898.  
  899. 'get the specified record to TheRecord
  900. 'used for non-keyed access
  901.  
  902. AP.Func = GetRecordXB
  903. AP.Handle = SDP.Handle
  904. AP.RecNo = RecNo&
  905. AP.RecPtrOff = VARPTR(TheRecord)
  906. AP.RecPtrSeg = VARSEG(TheRecord)
  907. GetRecord = BULLET(AP)
  908.  
  909. END FUNCTION
  910.  
  911. FUNCTION InKeyPick (waitfor)
  912.  
  913. 'get a key, if waitfor then wait until a key
  914.  
  915. DO
  916.    kb$ = INKEY$
  917.    kblen = LEN(kb$)
  918.    SELECT CASE kblen
  919.    CASE 0
  920.      kbkey = 0
  921.    CASE 1
  922.       kbkey = ASC(kb$)
  923.    CASE 2
  924.       kbkey = 1000 + ASC(RIGHT$(kb$, 1))
  925.    CASE ELSE
  926.    END SELECT
  927. LOOP UNTIL kbkey OR (waitfor = 0)
  928. InKeyPick = kbkey
  929.  
  930. END FUNCTION
  931.  
  932. SUB InKeyResponse (row, col, maxlen, ret$)
  933.  
  934. 'get user input through STDIN
  935. 'bytes adjusted +2 to account for CR/LF
  936. 'note: DOS limits input through STDIN from the keyboard to 127+2 characters
  937. '      the +2 is for the CR/LF
  938. 'ret$ is stripped of the CR/LF
  939.  
  940. CONST STDIN = 0
  941.  
  942. WCP.Func = CursorWIN
  943. WCP.Mode = 1
  944. WCP.x0 = col
  945. WCP.y0 = row
  946. WCP.vmode = -1
  947. stat = ZWINDO(WCP)
  948.  
  949. DFP.Func = ReadFileDOS
  950. DFP.Handle = STDIN
  951. DFP.Bytes = maxlen + 2
  952. IF DFP.Bytes > LEN(TmpStr) THEN DFP.Bytes = LEN(TmpStr)
  953.  
  954. DFP.BufferPtrOff = VARPTR(TmpStr)
  955. DFP.BufferPtrSeg = VARSEG(TmpStr)
  956. stat = BULLET(DFP)
  957. IF stat = 0 THEN
  958.    ret$ = LEFT$(TmpStr, DFP.Bytes)
  959.    t = INSTR(ret$, CHR$(13))
  960.    IF t > 1 THEN ret$ = LEFT$(ret$, t - 1) ELSE ret$ = ""
  961. ELSE
  962.    ret$ = ""
  963. END IF
  964.  
  965. WCP.x0 = 0
  966. WCP.y0 = 25
  967. WCP.vmode = -1
  968. stat = ZWINDO(WCP)
  969.  
  970. END SUB
  971.  
  972. FUNCTION InMousePick
  973.  
  974. 'if mouse left button down and cursor is on a event button then
  975. 'set gActiveButton and return 13 else just return 0
  976.  
  977. 'bx=button status
  978. 'cx=horz cursor coor
  979. 'dx=vert cursor coor
  980.  
  981. MouseFunc 3, IM, OM
  982.  
  983. 'txt$ = STR$(OM.cx \ 8) + STR$(OM.dx \ 8) + "   "
  984. 'WinPrt txt$, 24, 0, LEN(txt$), 1, ISFG, ISBG
  985.  
  986. match = 0
  987. IF OM.bx = 1 THEN
  988.    mx = OM.cx \ 8
  989.    my = OM.dx \ 8
  990.  
  991.    FOR i = 1 TO MAXBUTTONS
  992.       x0 = ButtonSpots(i).x0
  993.       y0 = ButtonSpots(i).y0
  994.       x1 = x0 + ButtonSpots(i).xs - 1
  995.       y1 = y0 + ButtonSpots(i).ys - 1
  996.       
  997.       'check for match in horz and vert positions
  998.       'return button's key value
  999.  
  1000.       IF mx >= x0 AND mx <= x1 THEN
  1001.          IF my >= y0 AND my <= y1 THEN
  1002.             match = ButtonSpots(i).kv
  1003.             SELECT CASE i
  1004.             CASE 1 'up/down slider
  1005.                match = match + (my - y0)
  1006.             CASE 2 'left/right slider
  1007.                match = match + (mx - x0)
  1008.             CASE ELSE
  1009.             END SELECT
  1010.  
  1011.             'txt$ = STR$(match)
  1012.             'WinPrt txt$, 24, 10, LEN(txt$), 1, ISFG, ISBG
  1013.  
  1014.             EXIT FOR
  1015.          END IF
  1016.       END IF
  1017.    NEXT
  1018.  
  1019. END IF
  1020. InMousePick = match
  1021.  
  1022. END FUNCTION
  1023.  
  1024. SUB MouseFunc (Func, IM AS MouseTYPE, OM AS MouseTYPE)
  1025.  
  1026. 'mouse function routine
  1027.  
  1028. IF (IsMouse = 0 AND Func > 0) AND (Func <> 21) THEN EXIT SUB
  1029.  
  1030. xreg.es = -1    'IM.ax used to pass ES segment register if needed
  1031. SELECT CASE Func
  1032. CASE 0   'MOUSE RESET AND STATUS
  1033.          'set: nothing
  1034.          'rtn: ax=status (0=not found/not reset)
  1035.          '     bx=buttons
  1036.    DEF SEG = 0
  1037.    ms& = 256& * PEEK(207) + PEEK(206)
  1038.    IF ms& > 32767 THEN ms& = ms& - 65536
  1039.    MouseSeg = ms&
  1040.    MouseOff = PEEK(204) + 256 * PEEK(205)
  1041.    DEF SEG = MouseSeg
  1042.    MouseExists = (MouseSeg <> 0 OR MouseOff <> 0) AND PEEK(MouseOff) <> &HCF
  1043.    DEF SEG
  1044.    IF MouseExists THEN
  1045.       xreg.ax = 0
  1046.    ELSE OM.ax = 0
  1047.       EXIT SUB
  1048.    END IF
  1049. CASE 1   'SHOW CURSOR
  1050.          'set: nothing
  1051.          'rtn: nothing
  1052.    xreg.ax = 1
  1053. CASE 2   'HIDE CURSOR
  1054.          'set: nothing
  1055.          'rtn: nothing
  1056.    xreg.ax = 2
  1057. CASE 3   'GET BUTTON STATUS AND MOUSE POS
  1058.          'set: nothing
  1059.          'rtn: bx=button status
  1060.          '     cx=horz cursor coor
  1061.          '     dx=vert cursor coor
  1062.    xreg.ax = 3
  1063. CASE 4   'SET MOUSE CURSOR POS
  1064.          'set: cx=new horz cursor pos
  1065.          '     dx=new vert cursor pos
  1066.          'rtn: nothing
  1067.    xreg.ax = 4
  1068.    xreg.cx = IM.cx
  1069.    xreg.dx = IM.dx
  1070. CASE 5   'GET BUTTON PRESS INFO
  1071.          'set: bx=button
  1072.          'rtn: ax=button status
  1073.          '     bx=number of button presses
  1074.          '     cx=horz cursor coor at last press
  1075.          '     dx=vert cursor coor at last press
  1076.    xreg.ax = 5
  1077.    xreg.bx = IM.bx
  1078. CASE 6   'GET BUTTON RELEASE INFO
  1079.          'set: bx=button
  1080.          'rtn: ax=button status
  1081.          '     bx=number of button releases
  1082.          '     cx=horz cursor coor at last release
  1083.          '     dx=vert cursor coor at last release
  1084.    xreg.ax = 6
  1085.    xreg.bx = IM.bx
  1086. CASE 7   'SET MIN AND MAX HORZ CURSOR POS
  1087.          'set: cx=min pos
  1088.          '     dx=max pos
  1089.          'rtn: nothing
  1090.    xreg.ax = 7
  1091.    xreg.cx = IM.cx
  1092.    xreg.dx = IM.dx
  1093. CASE 8   'SET MIN AND MAX VERT CURSOR POS
  1094.          'set: cx=min pos
  1095.          '     dx=max pos
  1096.          'rtn: nothing
  1097.    xreg.ax = 8
  1098.    xreg.cx = IM.cx
  1099.    xreg.dx = IM.dx
  1100. CASE 9   'SET GRAPHICS CURSOR BLOCK
  1101.          'set: ax=segment of cursor mask (NEVER DEFAULT)
  1102.          '     bx=horz cursor hot spot
  1103.          '     cx=vert cursor hot spot
  1104.          '     dx=pointer to screen
  1105.          'rtn: nothing
  1106.    xreg.ax = 9
  1107.    xreg.bx = IM.bx
  1108.    xreg.cx = IM.cx
  1109.    xreg.dx = IM.dx
  1110.    xreg.es = IM.ax
  1111. CASE 10  'SET TEXT CURSOR
  1112.          'set: bx=cursor select
  1113.          '     cx=screen mask value or scan line start
  1114.          '     dx=cursor mask value or scan line start
  1115.          'rtn: nothing
  1116.    xreg.ax = 10
  1117.    xreg.bx = IM.bx
  1118.    xreg.cx = IM.cx
  1119.    xreg.dx = IM.dx
  1120. CASE 11  'READ MOUSE MOTION COUNTERS
  1121.          'set: nothing
  1122.          'rtn: cx=horz mickey count
  1123.          '     dx=vert mickey count
  1124.    xreg.ax = 11
  1125. CASE 12  'SET INTERRUPT SUBROUTINE CALL MASK AND ADDRESS
  1126.          'set: ax=segment of subroutine (NEVER DEFAULT)
  1127.          '     cx=call mask.........bit 0-cursor pos changed
  1128.          '     dx=offset of subroutine '1-left button pressed
  1129.          'rtn: nothing                 '2-left button released
  1130.    xreg.ax = 12                        '3-right button pressed
  1131.    xreg.cx = IM.cx                     '4-right button released
  1132.    xreg.dx = IM.dx                     '5-15 not used
  1133.    xreg.es = IM.ax
  1134. CASE 13  'LIGHT PEN EMULATION MODE ON
  1135.          'set: nothing
  1136.          'rtn: nothing
  1137.    xreg.ax = 13
  1138. CASE 14  'LIGHT PEN EMULATION MODE OFF
  1139.          'set: nothing
  1140.          'rtn: nothing
  1141.    xreg.ax = 14
  1142. CASE 15  'SET MICKEY/PIXEL RATIO
  1143.          'set: cx=horz mickey to pixel ratio
  1144.          '     dx=vert mickey to pixel ratio
  1145.          'rtn: nothing
  1146.    xreg.ax = 15
  1147.    xreg.cx = IM.cx
  1148.    xreg.dx = IM.dx
  1149. CASE 16  'CONDITIONAL OFF
  1150.          'set: ax=left x (slightly different than regular calling registers)
  1151.          '     bx=upper y
  1152.          '     cx=right x
  1153.          '     dx=lower y
  1154.          'rtn: nothing
  1155.    xreg.ax = 16
  1156.    xreg.cx = IM.ax
  1157.    xreg.dx = IM.bx
  1158.    xreg.si = IM.cx
  1159.    xreg.DI = IM.dx
  1160. CASE 17, 18
  1161. CASE 19  'SET DOUBLE-SPEED THRESHOLD
  1162.          'set: dx=threshold speed in mickeys/seconds
  1163.          'rtn: nothing
  1164.    xreg.ax = 19
  1165.    xreg.dx = IM.dx
  1166. CASE 20  'SWAP INTERRUPT ROUTINES
  1167.          'set: ax=segment of subroutine (NEVER DEFAULT)
  1168.          '     cx=call mask (as in func 12 above)
  1169.          '     dx=offset of subroutine        ***********************
  1170.          'rtn: bx=segment of old subroutine   *Rtn values valid only*
  1171.          '     cx=call mask of old subroutine *if previous interrupt*
  1172.          '     dx=offset of old subroutine    *was created          *
  1173.    xreg.ax = 20                              '***********************
  1174.    xreg.cx = IM.cx
  1175.    xreg.dx = IM.dx
  1176.    xreg.es = IM.ax
  1177.    INTERRUPTX &H33, xreg, xreg
  1178.    OM.ax = 0
  1179.    OM.bx = xreg.es
  1180.    OM.cx = xreg.cx
  1181.    OM.dx = xreg.dx
  1182.    EXIT SUB
  1183. CASE 21  'GET MOUSE DRIVER STATE STORAGE REQUIREMENTS
  1184.          'set: nothing
  1185.          'rtn: bx=buffer size in bytes
  1186.    IF MouseExists THEN xreg.ax = 21 ELSE OM.bx = 0: EXIT SUB
  1187. CASE 22  'SAVE MOUSE DRIVER STATE
  1188.          'set: ax=segment of buffer
  1189.          '     dx=offset of buffer
  1190.          'rtn: nothing
  1191.    xreg.ax = 22
  1192.    xreg.dx = IM.dx
  1193.    xreg.es = IM.ax
  1194. CASE 23  'RESTORE MOUSE DRIVER STATE
  1195.          'set: ax=segment of buffer
  1196.          '     dx=offset of buffer
  1197.          'rtn: nothing
  1198.    xreg.ax = 23
  1199.    xreg.dx = IM.dx
  1200.    xreg.es = IM.ax
  1201. CASE 24  'SET ALTERNATE SUBROUTINE CALL MASK AND ADDRESS
  1202.          'set: ax=segment of user subroutine
  1203.          '     cx=call mask.........bit 0-cursor pos changed
  1204.          '     dx=offset of subroutine '1-left button pressed
  1205.          'rtn: ax=error status (-1)    '2-left button released
  1206.    xreg.ax = 24                        '3-right button pressed
  1207.    xreg.cx = IM.cx                     '4-right button released
  1208.    xreg.dx = IM.dx                     '5-shift key down w/button
  1209.    xreg.es = IM.ax                     '6-ctrl key down w/button
  1210.                                        '7-alt key down w/button
  1211.                                        '8-15 not used
  1212. CASE 25  'GET USER ALTERNATE INTERRUPT ADDRESS
  1213.          'set: cx=user interrupt call mask
  1214.          'rtn: ax=error status (-1)
  1215.          '     bx=segment of user subroutine
  1216.          '     cx=call mask of user interrupt
  1217.          '     dx=offset of subroutine
  1218.    xreg.ax = 25
  1219.    xreg.cx = IM.cx
  1220. CASE 26  'SET MOUSE SENSITIVITY
  1221.          'set: bx=horz mickey sensitivity (0 to 100)  these all
  1222.          '     cx=vert mickey sensitivity (0 to 100)   have default
  1223.          '     dx=threshold for double speed (0 to 100) values=50
  1224.          'rtn: nothing
  1225.    xreg.ax = 26
  1226.    xreg.bx = IM.bx
  1227.    xreg.cx = IM.cx
  1228.    xreg.dx = IM.dx
  1229. CASE 27  'GET MOUSE SENSITIVITY
  1230.          'set: nothing
  1231.          'rtn: bx=horz mickey sensitivity (0 to 100)
  1232.          '     cx=vert mickey sensitivity (0 to 100)
  1233.          '     dx=threshold for double speed (0 to 100)
  1234.    xreg.ax = 27
  1235. CASE 28  'SET MOUSE INTERRUPT RATE (InPort mouse ONLY)
  1236.          'set: bx=rate number (0 (0/sec) to 4 (200/sec))
  1237.          'rtn: nothing
  1238.    xreg.ax = 28
  1239.    xreg.bx = IM.bx
  1240. CASE 29  'SET CRT PAGE NUMBER
  1241.          'set: bx=CRT page for mouse cursor display
  1242.          'rtn: nothing
  1243.    xreg.ax = 29
  1244.    xreg.bx = IM.bx
  1245. CASE 30  'GET CRT PAGE NUMBER
  1246.          'set: nothing
  1247.          'rtn: bx=CRT page for current mouse cursor display
  1248.    xreg.ax = 30
  1249. CASE 31  'DISABLE MOUSE DRIVER
  1250.          'set: nothing
  1251.          'rtn: ax=error status (-1)
  1252.          '     bx=segment of old int 33h
  1253.          '     dx=offset of old int 33h
  1254.    xreg.ax = 31
  1255.    INTERRUPTX &H33, xreg, xreg
  1256.    OM.ax = xreg.ax
  1257.    OM.bx = xreg.es
  1258.    OM.cx = 0
  1259.    OM.dx = xreg.bx
  1260.    EXIT SUB
  1261. CASE 32  'ENABLE MOUSE DRIVER
  1262.          'set: nothing
  1263.          'rtn: nothing
  1264.    xreg.ax = 32
  1265. CASE 33  'SOFTWARE RESET
  1266.          'set: nothing
  1267.          'rtn: ax=-1 (or 33 if mouse drive not installed)
  1268.          '     bx=2 (if ax=-1. Must=2 for a valid reset)
  1269.    xreg.ax = 33
  1270. CASE 34  'SET LANGUAGE FOR MESSAGES (International MOUSE.xxx ONLY)
  1271.          'set: bx=language number
  1272.          'rtn: nothing
  1273.    xreg.ax = 34
  1274.    xreg.bx = IM.bx
  1275. CASE 35  'GET LANGUAGE NUMBER
  1276.          'set: nothing
  1277.          'rtn: bx=language number
  1278.    xreg.ax = 35
  1279. CASE 36  'GET DRIVER VERSION,MOUSE TYPE,AND IRQ NUMBER
  1280.          'set: nothing
  1281.          'rtn: bx=mouse driver version number
  1282.          '        bh=major
  1283.          '        bl=minor
  1284.          '     cx=mouse type and IRQ number
  1285.          '        ch=mouse type (1=bus,2=serial,3=InPort,4=PS/2,5=HP)
  1286.          '        cl=IRQ number (0=PS/2, 2-5 or 7=mouse IRQ)
  1287.    xreg.ax = 36
  1288. CASE ELSE
  1289.    OM.ax = 0
  1290.    OM.bx = 0
  1291.    OM.cx = 0
  1292.    OM.dx = 0
  1293.    EXIT SUB
  1294. END SELECT
  1295.  
  1296. INTERRUPTX &H33, xreg, xreg
  1297. OM.ax = xreg.ax
  1298. OM.bx = xreg.bx
  1299. OM.cx = xreg.cx
  1300. OM.dx = xreg.dx
  1301.  
  1302. END SUB
  1303.  
  1304. SUB MouseTurn (onoff)
  1305.  
  1306. 'turn the mouse cursor on/off
  1307.  
  1308. IF onoff THEN
  1309.    MouseFunc 1, IM, OM  'show
  1310. ELSE
  1311.    MouseFunc 2, IM, OM  'hide
  1312. END IF
  1313.  
  1314. END SUB
  1315.  
  1316. SUB ShowDBFStruc (ask4, ask$, ret$)
  1317.  
  1318. 'display .DBF structure for first 60 fields, any others are not shown
  1319. 'uses a new screen
  1320. 'if ask4 then prompts ask$ for input to ret$
  1321.  
  1322. MaxFldRows = 20
  1323. row = 0
  1324. col = 0
  1325. FirstChar = 1
  1326. fg = ISFG
  1327. bg = ISBG
  1328.  
  1329. WinGet 0, 0, 25, 80, 0
  1330. WinClr 0, 0, 25, 80, 32, fg, bg
  1331.  
  1332. txt$ = " #  FieldName  T  Len  DC"
  1333. WinPrt txt$, row, col, LEN(txt$), FirstChar, fg, bg
  1334. row = row + 1
  1335. txt$ = "──  ─────────  ─  ───  ──"
  1336. WinPrt txt$, row, col, LEN(txt$), FirstChar, fg, bg
  1337. row = row + 1
  1338.  
  1339. FOR i = 1 TO SDP.fields
  1340.    IF i <= MaxFldRows THEN
  1341.       txt$ = RIGHT$(" " + STR$(i), 2)
  1342.       WinPrt txt$, row, col, LEN(txt$), FirstChar, fg, bg
  1343.       txt$ = StrucDBF(i).FieldName
  1344.       WinPrt txt$, row, col + 4, LEN(txt$), FirstChar, fg, bg
  1345.       txt$ = StrucDBF(i).FieldType
  1346.       WinPrt txt$, row, col + 15, LEN(txt$), FirstChar, fg, bg
  1347.       txt$ = RIGHT$("  " + STR$(StrucDBF(i).FieldLen), 3)
  1348.       WinPrt txt$, row, col + 18, LEN(txt$), FirstChar, fg, bg
  1349.       txt$ = RIGHT$(" " + STR$(StrucDBF(i).FieldDC), 2)
  1350.       WinPrt txt$, row, col + 23, LEN(txt$), FirstChar, fg, bg
  1351.       row = row + 1
  1352.    ELSEIF i <= MaxFldRows * 2 THEN
  1353.       IF i = MaxFldRows + 1 THEN
  1354.          row = 0
  1355.          col = 28
  1356.          txt$ = " #  FieldName  T  Len  DC"
  1357.          WinPrt txt$, row, col, LEN(txt$), FirstChar, fg, bg
  1358.          row = row + 1
  1359.          txt$ = "──  ─────────  ─  ───  ──"
  1360.          WinPrt txt$, row, col, LEN(txt$), FirstChar, fg, bg
  1361.          row = row + 1
  1362.       END IF
  1363.       txt$ = RIGHT$(" " + STR$(i), 2)
  1364.       WinPrt txt$, row, col, LEN(txt$), FirstChar, fg, bg
  1365.       txt$ = StrucDBF(i).FieldName
  1366.       WinPrt txt$, row, col + 4, LEN(txt$), FirstChar, fg, bg
  1367.       txt$ = StrucDBF(i).FieldType
  1368.       WinPrt txt$, row, col + 15, LEN(txt$), FirstChar, fg, bg
  1369.       txt$ = RIGHT$("  " + STR$(StrucDBF(i).FieldLen), 3)
  1370.       WinPrt txt$, row, col + 18, LEN(txt$), FirstChar, fg, bg
  1371.       txt$ = RIGHT$(" " + STR$(StrucDBF(i).FieldDC), 2)
  1372.       WinPrt txt$, row, col + 23, LEN(txt$), FirstChar, fg, bg
  1373.       row = row + 1
  1374.    ELSEIF i <= MaxFldRows * 3 THEN
  1375.       IF i = (MaxFldRows * 2) + 1 THEN
  1376.          row = 0
  1377.          col = 55
  1378.          txt$ = " #  FieldName  T  Len  DC"
  1379.          WinPrt txt$, row, col, LEN(txt$), FirstChar, fg, bg
  1380.          row = row + 1
  1381.          txt$ = "──  ─────────  ─  ───  ──"
  1382.          WinPrt txt$, row, col, LEN(txt$), FirstChar, fg, bg
  1383.          row = row + 1
  1384.       END IF
  1385.       txt$ = RIGHT$(" " + STR$(i), 2)
  1386.       WinPrt txt$, row, col, LEN(txt$), FirstChar, fg, bg
  1387.       txt$ = StrucDBF(i).FieldName
  1388.       WinPrt txt$, row, col + 4, LEN(txt$), FirstChar, fg, bg
  1389.       txt$ = StrucDBF(i).FieldType
  1390.       WinPrt txt$, row, col + 15, LEN(txt$), FirstChar, fg, bg
  1391.       txt$ = RIGHT$("  " + STR$(StrucDBF(i).FieldLen), 3)
  1392.       WinPrt txt$, row, col + 18, LEN(txt$), FirstChar, fg, bg
  1393.       txt$ = RIGHT$(" " + STR$(StrucDBF(i).FieldDC), 2)
  1394.       WinPrt txt$, row, col + 23, LEN(txt$), FirstChar, fg, bg
  1395.       row = row + 1
  1396.    ELSE
  1397.       txt$ = "--More fields not shown--"
  1398.       WinPrt txt$, 24, col, LEN(txt$), FirstChar, ISFG, ISBG
  1399.       row = row + 1
  1400.       EXIT FOR
  1401.    END IF
  1402. NEXT
  1403. IF ask4 THEN
  1404.    WinPrt ask$, 23, 0, LEN(ask$), FirstChar, ISFG, ISBG
  1405.    InKeyResponse 23, LEN(ask$) + 1, ask4, ret$
  1406. ELSE
  1407.    txt$ = "Press a key to continue..."
  1408.    WinPrt txt$, 24, 0, LEN(txt$), FirstChar, ISFG, ISBG
  1409.    kbkey = WaitForKey
  1410. END IF
  1411. WinPut 0, 0, 25, 80, 0
  1412.  
  1413. '----------------------
  1414. 'put up the header line (huh, whaduya mean use go-subs?)
  1415.  
  1416. 'OutHdrLine:
  1417. 'txt$ = " #  FieldName  T  Len  DC"
  1418. 'WinPrt txt$, row, col, LEN(txt$), FirstChar, fg, bg
  1419. 'row = row + 1
  1420. 'txt$ = "──  ─────────  ─  ───  ──"
  1421. 'WinPrt txt$, row, col, LEN(txt$), FirstChar, fg, bg
  1422. 'row = row + 1
  1423. 'RETURN
  1424. '
  1425. ''----------------------
  1426. ''put up the detail line
  1427. '
  1428. 'OutDetailLine:
  1429. 'txt$ = RIGHT$(" " + STR$(i), 2)
  1430. 'WinPrt txt$, row, col, LEN(txt$), FirstChar, fg, bg
  1431. 'txt$ = StrucDBF(i).FieldName
  1432. 'WinPrt txt$, row, col + 4, LEN(txt$), FirstChar, fg, bg
  1433. 'txt$ = StrucDBF(i).FieldType
  1434. 'WinPrt txt$, row, col + 15, LEN(txt$), FirstChar, fg, bg
  1435. 'txt$ = RIGHT$("  " + STR$(StrucDBF(i).FieldLen), 3)
  1436. 'WinPrt txt$, row, col + 18, LEN(txt$), FirstChar, fg, bg
  1437. 'txt$ = RIGHT$(" " + STR$(StrucDBF(i).FieldDC), 2)
  1438. 'WinPrt txt$, row, col + 23, LEN(txt$), FirstChar, fg, bg
  1439. 'row = row + 1
  1440. 'RETURN
  1441. '
  1442. END SUB
  1443.  
  1444. SUB ShowFieldNames (StartField)
  1445.  
  1446. 'put up field names, starting at StartField, for as many as will fit on screen
  1447.  
  1448. row = SSROW
  1449. col = 0
  1450. MaxChars = 80
  1451. FirstChar = 1
  1452. fg = ISFG
  1453. bg = ISBG
  1454. WinClr row, col, 1, 80, 32, fg, bg
  1455.  
  1456. txt$ = "Recno-- "
  1457. WinPrt txt$, row, col, LEN(txt$), FirstChar, fg, bg
  1458. col = col + LEN(txt$)
  1459.  
  1460. fg = HSFG
  1461. bg = HSBG
  1462.  
  1463. 'put up the field names, if field name is longer than field size, okay,
  1464. 'if field size is longer than field name then add extension characters
  1465.  
  1466. LastCol = col
  1467. cnt = 0
  1468. FOR i = StartField TO SDP.fields
  1469.    xchars = 0
  1470.    txt$ = LEFT$(StrucDBF(i).FieldName, INSTR(StrucDBF(i).FieldName, ZSTR) - 1)
  1471.    tl = LEN(txt$)
  1472.    IF StrucDBF(i).FieldLen > tl THEN xchars = StrucDBF(i).FieldLen - tl
  1473.    LastCol = LastCol + tl + xchars + 1
  1474.    txt$ = txt$ + STRING$(xchars, "-") + " "
  1475.  
  1476.    'check if entire field fits, if so okay
  1477.    'if not, and not first field then exit w/o putting up fieldname
  1478.    'if first field (or start field) then put it up but truncate
  1479.    'if more fields exist or only partial field a double right-arrow is added
  1480.  
  1481.    IF LastCol < 79 THEN
  1482.       WinPrt txt$, row, col, LEN(txt$), FirstChar, fg, bg
  1483.       col = col + LEN(txt$)
  1484.       cnt = cnt + 1
  1485.    ELSE
  1486.       IF i = StartField THEN
  1487.          WinPrt txt$, row, col, (79 - col), FirstChar, fg, bg
  1488.          col = 79
  1489.          cnt = 1
  1490.       END IF
  1491.       txt$ = "»"
  1492.       WinPrt txt$, row, col, 1, FirstChar, fg, bg
  1493.       EXIT FOR
  1494.    END IF
  1495. NEXT
  1496.  
  1497. 'update field display info
  1498.  
  1499. FDI.FirstField = StartField
  1500. FDI.FieldsDisplayed = cnt
  1501.  
  1502. END SUB
  1503.  
  1504. SUB ShowMainScreen (infile$)
  1505.  
  1506. 'put up the main screen
  1507.  
  1508. row = 0: col = 0
  1509. MaxChars = 80: FirstChar = 1
  1510. fg = ISFG: ISBG = 0
  1511. atxt$(1) = "┌──────────────────────────────────────────────────────────────────────────────┐"
  1512. atxt$(2) = "│Ver:       DOS:       SHARE:            Locking:        Elap time:       secs │"
  1513. atxt$(3) = "│DBF:                                                                          │"
  1514. atxt$(4) = "│Recs:          RecLen:         Flds:      Last Update:   /  /     Dirty:      │"
  1515. atxt$(5) = "│IX:       KX:                                                                 │"
  1516. atxt$(6) = "│KY:                                                                  EW:      │"
  1517. atxt$(7) = "│Keys:          KeyLen:     KeyFlags:                NLS:          Dirty:      │"
  1518. atxt$(8) = "└──────────────────────────────────────────────────────────────────────────────┘"
  1519. FL = 1
  1520. FOR i = FL TO 8
  1521.    WinPrt atxt$(i), row, col, MaxChars, FirstChar, fg, bg
  1522.    row = row + 1
  1523. NEXT
  1524.  
  1525. col = 0
  1526. fg = HSFG: bg = HSBG
  1527. atxt$(1) = SPACE$(80)
  1528. WinPrt atxt$(1), row, col, MaxChars, FirstChar, fg, bg
  1529. row = row + 1
  1530.  
  1531. col = 79
  1532. fg = ISFG: bg = ISBG
  1533. atxt$(1) = "■"
  1534. atxt$(2) = "│"
  1535. atxt$(3) = "│"
  1536. atxt$(4) = "│"
  1537. atxt$(5) = "│"
  1538. atxt$(6) = "│"
  1539. atxt$(7) = "│"
  1540. atxt$(8) = "│"
  1541. atxt$(9) = ""
  1542. atxt$(10) = ""
  1543. FOR i = FL TO 10
  1544.    WinPrt atxt$(i), row, col, MaxChars, FirstChar, fg, bg
  1545.    row = row + 1
  1546. NEXT
  1547.  
  1548. col = 0
  1549. atxt$(1) = " ■──────────────────────────────────────────────────────────────────────────  "
  1550. WinPrt atxt$(1), row, col, MaxChars, FirstChar, fg, bg
  1551. row = row + 1
  1552.  
  1553. fg = ISFG: bg = ISBG
  1554. atxt$(1) = "┌──────────────────────────────────────────────────────────────────────────────┐"
  1555. atxt$(2) = "│F1-       F3-Select IX   F5-             F7-          F9-                     │"
  1556. atxt$(3) = "│F2-       F4-            F6-Disp Struc   F8-          F10-            ESC Quit│"
  1557. atxt$(4) = "└──────────────────────────────────────────────────────────────────────────────┘"
  1558. atxt$(5) = "IDEMO for BULLET                                                  Mode: BROWSE  "
  1559. FOR i = FL TO 5
  1560.    WinPrt atxt$(i), row, col, MaxChars, FirstChar, fg, bg
  1561.    row = row + 1
  1562. NEXT
  1563.  
  1564. txt$ = RIGHT$(STR$(IP.version \ 100), 1) + "." + RIGHT$("0" + LTRIM$(STR$(IP.version MOD 100)), 2)
  1565. WinPrt txt$, 1, 6, 4, 1, ISFGB, ISBG
  1566.  
  1567. txt$ = RIGHT$(STR$(IP.DOSver \ 256), 1) + "." + RIGHT$("0" + LTRIM$(STR$(IP.DOSver AND 255)), 2)
  1568. WinPrt txt$, 1, 17, 4, 1, ISFGB, ISBG
  1569.  
  1570. IF RP.IsShare THEN txt$ = "installed" ELSE txt$ = "not inst "
  1571. WinPrt txt$, 1, 30, 9, 1, ISFGB, ISBG
  1572.  
  1573. IF LockFlag = 0 THEN txt$ = "off" ELSE txt$ = "on"
  1574. IF RP.IsShare = 0 THEN txt$ = "n/a"
  1575. WinPrt txt$, 1, 50, 3, 1, ISFGB, ISBG
  1576. IF RP.IsRemote = 0 THEN t$ = " - local " ELSE t$ = " - remote"
  1577. WinPrt infile$ + t$, 2, 6, 73, 1, ISFGB, ISBG
  1578.  
  1579. 'SDP.recs,reclen,fields,dirty,LUyear...
  1580. txt$ = STR$(SDP.Recs)
  1581. WinPrt txt$, 3, 6, 8, 1, ISFGB, ISBG
  1582. txt$ = STR$(SDP.RecLen)
  1583. WinPrt txt$, 3, 23, 5, 1, ISFGB, ISBG
  1584. txt$ = STR$(SDP.fields)
  1585. WinPrt txt$, 3, 37, 4, 1, ISFGB, ISBG
  1586. txt$ = STR$(ASC(SDP.LUmonth))
  1587. txt$ = RIGHT$("0" + LTRIM$(STR$(ASC(SDP.LUmonth))), 2)
  1588. WinPrt txt$, 3, 56, 5, 1, ISFGB, ISBG
  1589. txt$ = RIGHT$("0" + LTRIM$(STR$(ASC(SDP.LUday))), 2)
  1590. WinPrt txt$, 3, 59, 5, 1, ISFGB, ISBG
  1591. txt$ = RIGHT$("0" + LTRIM$(STR$(ASC(SDP.LUyear))), 2)
  1592. WinPrt txt$, 3, 62, 5, 1, ISFGB, ISBG
  1593. IF ASC(SDP.Dirty) = 0 THEN txt$ = "no" ELSE txt$ = "yes"
  1594. WinPrt txt$, 3, 74, 5, 1, ISFGB, ISBG
  1595.  
  1596. EXIT SUB
  1597.  
  1598. OutLines:
  1599. FOR i = FL TO LL
  1600.    WinPrt atxt$(i), row, col, MaxChars, FirstChar, fg, bg
  1601.    row = row + 1
  1602. NEXT
  1603. RETURN
  1604.  
  1605. END SUB
  1606.  
  1607. SUB ShowNewFields (newfield)
  1608.  
  1609. 'refresh scroll screen to reflect newfield start
  1610.  
  1611. IF newfield <= 0 THEN              'OR PI.HorzSlide = 0 THEN
  1612.    newfield = 1
  1613. ELSEIF newfield > SDP.fields THEN  'OR PI.HorzSlide = 74 THEN
  1614.    newfield = SDP.fields
  1615. END IF
  1616.  
  1617. WinClr SSROW + 1, 0, SSROWS, 79, 32, SSFG, SSBG
  1618. ShowFieldNames newfield
  1619.  
  1620. row = 0
  1621. FOR i& = RDI.TopRecord TO RDI.TopRecord + SSROWS - 1
  1622.    stat = GetRecord(i&)
  1623.    IF stat THEN EXIT FOR
  1624.    row = row + 1
  1625.    DisplayRecord i&, SSROW + row
  1626. NEXT
  1627. DoHighlight PI.ScreenRow
  1628.  
  1629. END SUB
  1630.  
  1631. SUB ShowStartCL
  1632.  
  1633. row = 0: col = 0
  1634. MaxChars = 80: FirstChar = 1
  1635. fg = ISFG: ISBG = 0
  1636. atxt$(1) = "IDEMO is an interactive demo program for the BULLET b-tree/DBF file manager"
  1637. atxt$(2) = "libraries for DOS compilers. IDEMO requires that you supply the filename of"
  1638. atxt$(3) = "the .DBF file to browse."
  1639. atxt$(4) = " "
  1640. atxt$(5) = "Use:  C>idemo pathname.DBF"
  1641. FOR i = 1 TO 5
  1642.    WinPrt atxt$(i), row, col, MaxChars, FirstChar, fg, bg
  1643.    row = row + 1
  1644. NEXT
  1645.  
  1646. END SUB
  1647.  
  1648. FUNCTION WaitForKey
  1649.  
  1650. 'wait for a keypress or mouse button press
  1651. 'return the ASCII key code (1000+x for extended keys, 13 for mouse button)
  1652. 'flushes KB buffer
  1653.  
  1654. DO
  1655.    kb$ = INKEY$
  1656.    kblen = LEN(kb$)
  1657.    SELECT CASE kblen
  1658.    CASE 0
  1659.       kbkey = 0
  1660.       IF IsMouse THEN
  1661.          MouseFunc 3, IM, OM
  1662.          IF OM.bx THEN kbkey = 13
  1663.       END IF
  1664.    CASE 1
  1665.       kbkey = ASC(kb$)
  1666.    CASE 2
  1667.       kbkey = 1000 + ASC(RIGHT$(kb$, 1))
  1668.    CASE ELSE
  1669.    END SELECT
  1670. LOOP UNTIL kbkey
  1671. DO: LOOP WHILE LEN(INKEY$)
  1672. WaitForKey = kbkey
  1673.  
  1674. END FUNCTION
  1675.  
  1676. SUB WinClr (row, col, rows, cols, char, fg, bg)
  1677.  
  1678. 'clear a window with char using attr
  1679. 'if char=0 then only attributes changed
  1680.  
  1681. WFP.Func = FillWIN
  1682. WFP.Mode = 0                    'default screen
  1683. WFP.page = 0
  1684. WFP.x0 = col
  1685. WFP.y0 = row
  1686. WFP.xsize = cols
  1687. WFP.ysize = rows
  1688. WFP.attrchar = 256& * ((bg * 16) + fg) + char
  1689. MouseTurn 0
  1690. nix = ZWINDO(WFP)
  1691. MouseTurn 1
  1692.  
  1693. END SUB
  1694.  
  1695. SUB WinGet (row, col, rows, cols, ID)
  1696.  
  1697. 'store the window area into the buffer
  1698.  
  1699. IF ID < 0 OR ID > MAXWINSAVES THEN STOP
  1700.  
  1701. WSP.Func = SaveWIN
  1702. WSP.Mode = 0                    'default screen
  1703. WSP.page = 0
  1704. WSP.x0 = col
  1705. WSP.y0 = row
  1706. WSP.xsize = cols
  1707. WSP.ysize = rows
  1708. WSP.BuffPtrOff = VARPTR(WinBuff(ID * 2000))
  1709. WSP.BuffPtrSeg = VARSEG(WinBuff(ID * 2000))
  1710. MouseTurn 0
  1711. nix = ZWINDO(WSP)
  1712. MouseTurn 1
  1713.  
  1714. END SUB
  1715.  
  1716. SUB WinPrt (txt$, row, col, MaxChars, FirstChar, fg, bg)
  1717.  
  1718. 'print the text string
  1719. 'row/col are 0-based
  1720. 'either print MaxChars or until 0-term
  1721. 'first character printed is specified by StartChar
  1722.  
  1723. TmpStr = txt$ + ZSTR
  1724.  
  1725. WPP.Func = PrintWIN
  1726. WPP.Mode = 0                    'default screen
  1727. WPP.page = 0
  1728. WPP.x0 = col
  1729. WPP.y0 = row
  1730. WPP.xsize = MaxChars
  1731. WPP.xoffset = FirstChar - 1     'ZWINDO's xoffset is 0-based
  1732. WPP.attr = (bg * 16) + fg
  1733. WPP.TextPtrOff = VARPTR(TmpStr)
  1734. WPP.TextPtrSeg = VARSEG(TmpStr)
  1735. MouseTurn 0
  1736. nix = ZWINDO(WPP)
  1737. MouseTurn 1
  1738.  
  1739. END SUB
  1740.  
  1741. SUB WinPut (row, col, rows, cols, ID)
  1742.  
  1743. 'restore the buffer to the window area
  1744.  
  1745. IF ID < 0 OR ID > MAXWINSAVES THEN STOP
  1746.  
  1747. WSP.Func = BackWIN
  1748. WSP.Mode = 0                    'default screen
  1749. WSP.page = 0
  1750. WSP.x0 = col
  1751. WSP.y0 = row
  1752. WSP.xsize = cols
  1753. WSP.ysize = rows
  1754. WSP.BuffPtrOff = VARPTR(WinBuff(ID * 2000))
  1755. WSP.BuffPtrSeg = VARSEG(WinBuff(ID * 2000))
  1756. MouseTurn 0
  1757. nix = ZWINDO(WSP)
  1758. MouseTurn 1
  1759.  
  1760. END SUB
  1761.  
  1762. SUB WinScroll (row, col, rows, cols, dir, fg, bg)
  1763.  
  1764. 'scroll the window and clear the first/last row
  1765.  
  1766. trows = rows - 1
  1767. IF dir > 0 THEN
  1768.    WinGet row + 1, col, trows, cols, 1
  1769.    WinPut row, col, trows, cols, 1
  1770.    WinPrt SPACE$(cols), row + rows - 1, col, cols, 1, fg, bg
  1771. ELSEIF dir < 0 THEN
  1772.    WinGet row, col, trows, cols, 1
  1773.    WinPut row + 1, col, trows, cols, 1
  1774.    WinPrt SPACE$(cols), row, col, cols, 1, fg, bg
  1775. ELSE
  1776.    WinClr row, col, rows, cols, 32, fg, bg
  1777. END IF
  1778.  
  1779. END SUB
  1780.  
  1781. SUB WinSetMode (page, row, col, cstart, cend, vmode)
  1782.  
  1783. 'set video mode using BIOS, move cursor off-screen
  1784.  
  1785. WCP.Func = CursorWIN
  1786. WCP.Mode = 1
  1787. WCP.page = page
  1788. WCP.x0 = 0
  1789. WCP.y0 = 25
  1790. WCP.cstart = cstart
  1791. WCP.cend = cend
  1792. WCP.vmode = vmode
  1793. MouseTurn 0
  1794. nix = ZWINDO(WCP)
  1795. MouseTurn 1
  1796.  
  1797. END SUB
  1798.  
  1799. SUB WinShift (row, col, rows, cols, dir, fg, bg)
  1800.  
  1801. tcols = cols - 1
  1802. IF dir > 0 THEN
  1803.    WinGet row, col + 1, rows, tcols, 1
  1804.    WinPut row, col, rows, tcols, 1
  1805.    WinClr row, col + cols - 1, rows, 1, 32, fg, bg
  1806. ELSEIF dir < 0 THEN
  1807.    WinGet row, col, rows, tcols, 1
  1808.    WinPut row, col + 1, rows, tcols, 1
  1809.    WinClr row, col, rows, 1, 32, fg, bg
  1810. ELSE
  1811.    WinClr row, col, rows, cols, 32, fg, bg
  1812. END IF
  1813.  
  1814. END SUB
  1815.  
  1816.